perm filename BIGMSS.F4[MSS,LCS] blob
sn#155850 filedate 1975-04-16 generic text, type T, neo UTF8
00100 C TO PUT .DAT MSS FILES TOGETHER AND TAKE APART. LOAD WITH MSFAIL
00200 DIMENSION SV(127)
00400 COMMON /POSI/STFF(8)
00600 1 ,V(78),ISCR,LCNT,LIST(200)
00800 1 ,RN(2200)
01000 1 ,RSTFAC(8),PWDS(250)
01200 EQUIVALENCE (SV,RN)
01400 TYPE 1
01600 1 FORMAT(' PACK, UNPACK? -- '$)
01800 ACCEPT 2,K
02000 2 FORMAT(A1)
02200 IF(K.NE.'U')GO TO 3
02400 6 TYPE 20
02600 ACCEPT 21,NAME
02650 NN=1
02700 TYPE 27
02800 27 FORMAT(' GET WHICH FILE? '$)
02900 ACCEPT 21,NZ,N
02950 IF(NZ.EQ.'ALL')NZ=' '
02975 IF(NZ.EQ.' ')N=999
03000 C BLANK GETS ALL
03400 GO TO 4
03600
03800 3 TYPE 26
04000 26 FORMAT(' TYPE OUTPUT FILE NAME -- '$)
04200 ACCEPT 21,NOUT
04400 REWIND 1
04500 IF(LOOKD(NOUT).GE.0)GO TO 100
04510 TYPE 101
04520 101 FORMAT(' WRITE OVER THIS FILE? '$)
04530 ACCEPT 2,L
04540 IF(L.EQ.'N')GO TO 3
04600 100 CALL OFILE(1,NOUT)
04800 25 TYPE 20
05000 20 FORMAT(' TYPE FILE NAME -- '$)
05200 ACCEPT 21,NAME,N
05210 NMZ=NAME
05400 IF(NAME.EQ.' ')GO TO 30
05600 NN=1
05800 IF(N.EQ.0)N=999
06000 C WILL READ ALL IT CAN FIND.
06200 21 FORMAT(A5,I)
06400 23 IF(LOOKD(NAME))GO TO 22
06600 C JUMP IF IT FOUND IT.
06800 TYPE 24
07000 24 FORMAT(' FILE NOT FOUND'/)
07200 GO TO 25
07400
07600 22 IF(LOOKD(NAME).GE.0)GO TO 25
07800 NM=NAME
08000 4 REWIND 21
08200 CALL IFILE(21,NAME)
08300 7 NMX=NAME
08400 9 READ(21,END=30)ITEM,I
08600 1,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,(V(L),L=1,ISCR),
08800 1 LCNT,(LIST(L),L=1,LCNT),RSTFAC,STFF,NAME
08900 IF(K.EQ.'U')GO TO 310
09000 READ(21,END=31)RSTFAC,STFF
09005 GO TO 31
09010 310 READ(21,END=31)RSTFAC,STFF,NAME
09110 IF(NZ.EQ.' ')GO TO 311
09160 IF(NZ.NE.NAME)GO TO 9
09185 C SEARCH FOR A PARTICULAR NAME.
09210 311 TYPE 10,NAME
09220 IF(LOOKD(NAME).GE.0)GO TO 102
09230 TYPE 101
09240 ACCEPT 2,L
09250 IF(L.NE.'N')GO TO 102
09260 C IF 'NO' GO BACK FOR NEXT FILE
09270 TYPE 103
09280 ACCEPT 21,NAME
09290 IF(NAME.EQ.' ')GO TO 9
09300 103 FORMAT(' TYPE NEW NAME -- '$)
09400 102 REWIND 1
09600 CALL OFILE(1,NAME)
09725 GO TO 11
09750 10 FORMAT(1XA5)
09775 31 TYPE 10,NMX
09787 11 ISCR=1
09793 LIST(1)=0
09796 C CLEARS MOTIVE LIST
09800 WRITE(1)ITEM,I,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,V(1),
10200 1 ISCR,LIST(1),RSTFAC,STFF,NM,SV
10400 WRITE(1)RSTFAC,STFF,NM,L,L,L
10600 IF(K.EQ.'U')GO TO 8
10800 IF(NN.LT.N)GO TO 5
11000 GO TO 25
11400
11600 5 NN=NN+1
11700 NAME=NMX
11800 NAME=NAME+2
12000 C GOES UP THE ALPHABET
12010 IF(LOOKD(NAME))GO TO 999
12110 NAME=NMZ+256
12155 NMZ=NAME
12200 999 IF(K.NE.'U')GO TO 22
12300 8 END FILE 1
12500 NN=NN+1
12525 NZ=' '
12550 IF(NN.LE.N)GO TO 9
12600 30 END